home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
str2bmp
/
test.frm
< prev
next >
Wrap
Text File
|
1995-09-06
|
9KB
|
324 lines
VERSION 2.00
Begin Form Form1
BackColor = &H00FF0000&
Caption = "Bitmap Function Tester."
ClientHeight = 4050
ClientLeft = 1860
ClientTop = 2190
ClientWidth = 7245
ClipControls = 0 'False
Height = 4455
Left = 1800
LinkTopic = "Form1"
ScaleHeight = 4050
ScaleWidth = 7245
Top = 1845
Width = 7365
Begin CommandButton CommandCopyResultToB
Caption = "Copy RESULT to B"
Height = 555
Left = 5040
TabIndex = 12
Top = 1380
Width = 2055
End
Begin CommandButton CommandAnd
Caption = "RESULT = A AND B"
Height = 555
Left = 5040
TabIndex = 11
Top = 780
Width = 2055
End
Begin PictureBox PictureResult
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 615
Left = 3240
ScaleHeight = 41
ScaleMode = 3 'Pixel
ScaleWidth = 81
TabIndex = 7
Top = 2820
Width = 1215
End
Begin CommandButton CommandOr
Caption = "RESULT = A OR B"
Height = 555
Left = 5040
TabIndex = 6
Top = 180
Width = 2055
End
Begin CommandButton CommandInvertA
Caption = "Invert A"
Height = 555
Left = 5040
TabIndex = 5
Top = 3180
Width = 2055
End
Begin CommandButton CommandCompareAtoB
Caption = "Compare A to B"
Height = 555
Left = 5040
TabIndex = 4
Top = 2580
Width = 2055
End
Begin PictureBox PictureA
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 615
Left = 360
ScaleHeight = 41
ScaleMode = 3 'Pixel
ScaleWidth = 81
TabIndex = 3
Top = 2820
Width = 1215
End
Begin PictureBox PictureB
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 615
Left = 1800
ScaleHeight = 41
ScaleMode = 3 'Pixel
ScaleWidth = 81
TabIndex = 2
Top = 2820
Width = 1215
End
Begin CommandButton CommandCopyAtoB
Caption = "Copy A to B"
Height = 555
Left = 5040
TabIndex = 1
Top = 1980
Width = 2055
End
Begin CommandButton CommandDrawCircle
Caption = "Draw Circles in A"
Height = 555
Left = 600
TabIndex = 0
Tag = "Write line to A"
Top = 600
Width = 3495
End
Begin Label Label3
BackColor = &H00FF0000&
Caption = "A"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FFFFFF&
Height = 255
Left = 840
TabIndex = 10
Top = 3540
Width = 255
End
Begin Label Label2
BackColor = &H00FF0000&
Caption = "B"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FFFFFF&
Height = 255
Left = 2280
TabIndex = 9
Top = 3600
Width = 255
End
Begin Label Label1
BackColor = &H00FF0000&
Caption = "Result"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FFFFFF&
Height = 255
Left = 3480
TabIndex = 8
Top = 3540
Width = 855
End
End
Option Explicit
' Strings to hold pixel information.
Dim A$
Dim B$
Dim RESULT$
Sub CommandAnd_Click ()
Dim bytes As Long
Dim ret%
bytes = BMP_GetSize(PictureA.Image)
If (bytes = 0) Then
MsgBox ("Bitmap too large to store!")
End
End If
A$ = Space$(bytes)
B$ = Space$(bytes)
RESULT$ = Space$(bytes)
ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)
ret% = BMPToString(PictureB.hDC, PictureB.Image, B$)
bytes = StringBMP_and(A$, B$, RESULT$)
ret% = StringToBmp(RESULT$, PictureResult.hDC, PictureResult.Image)
PictureResult.Refresh
End Sub
Sub CommandCompareAtoB_Click ()
Dim bytes As Long
Dim A$, B$
Dim ret%
bytes = BMP_GetSize(PictureA.Image)
If (bytes = 0) Then
MsgBox ("Bitmap too large to store!")
End
End If
A$ = Space$(bytes)
B$ = Space$(bytes)
ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)
If BMP_GetSize(PictureB.Image) <> bytes Then
MsgBox "Bitmaps must be same size to compare. "
End
End If
ret% = BMPToString(PictureB.hDC, PictureB.Image, B$)
bytes = StringBMP_Compare(A$, B$)
MsgBox "This difference is " + Str$(bytes) + " pixels."
End Sub
Sub CommandCopyAtoB_Click ()
Dim ret%
B$ = A$
' Fill PictureBox with information in B$
ret% = StringToBmp(B$, PictureB.hDC, PictureB.Image)
' Display the new information
PictureB.Refresh
End Sub
Sub CommandCopyResultToB_Click ()
Dim ret%
' Copy RESULT to B (STRINGS!)
B$ = RESULT$
' Convert the new B$ to a picture and display it!
ret% = StringToBmp(B$, PictureB.hDC, PictureB.Image)
PictureB.Refresh
End Sub
Sub CommandDrawCircle_Click ()
Dim ret%
Dim bytes As Long
' Draw a black circle
PictureA.FillStyle = 0
PictureA.FillColor = RGB(0, 0, 0)
PictureA.Circle (10, 10), 5, RGB(0, 0, 0)
PictureA.FillColor = RGB(255, 0, 0)
PictureA.Circle (40, 25), 5, RGB(255, 0, 0)
PictureA.FillColor = RGB(0, 255, 0)
PictureA.Circle (25, 30), 5, RGB(0, 255, 0)
' Determine the size of a string required to hold PictureA
bytes = BMP_GetSize(PictureA.Image)
If (bytes = 0) Then
MsgBox ("Bitmap too large to store as a string!")
End
End If
' Create a string of the proper size to hold picture box.
A$ = Space$(bytes)
' Convert PictureA into A$
ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)
End Sub
Sub CommandInvertA_Click ()
Dim bytes As Long
Dim ret%
Dim TEMP$
' Determine the size of a string required to hold PictureA
bytes = BMP_GetSize(PictureA.Image)
If (bytes = 0) Then
MsgBox ("Bitmap too large to store!")
End
End If
' Make sure space is allocated to hold all pixels in strings.
A$ = Space$(bytes)
TEMP$ = Space$(bytes)
' Copy PictureA into A$
ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)
' Invert A$ and store the result in RESULT$
ret% = StringBMP_Invert(A$, TEMP$)
A$ = TEMP$
' Convert A$ into a picture box and display.
ret% = StringToBmp(A$, PictureA.hDC, PictureA.Image)
PictureA.Refresh
End Sub
Sub CommandOr_Click ()
Dim bytes As Long
Dim ret%
' Make sure string